home *** CD-ROM | disk | FTP | other *** search
/ Scene 96 / Scene 96 International Edition (Zyklop Software) (Disc 2) (1997).iso / misc / coding / pump_src / setup / menus.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-10-26  |  3.8 KB  |  136 lines
  1. {$A+,B-,D+,E-,F-,G+,I-,L+,N-,O-,R-,S-,V-,X+}
  2. UNIT Menus;
  3.  
  4.    (* Copyright by Jare/Iguana in 1993, but given to the public domain. *)
  5.    (* Want more comments? Write'em!                                     *)
  6.  
  7.    (*   Nice simple menus. Nothing impressive here.                     *)
  8.  
  9.    (*   Modified in XMas'93 by Cesar Alba so that options not available *)
  10.    (* are shown in grey and the cursor skips them. Thank you Cesar!     *)
  11.  
  12. INTERFACE
  13.  
  14. TYPE
  15.    TMenuIt = RECORD
  16.       Text : STRING[60];
  17.       Val  : WORD;
  18.    END;
  19.  
  20.    PMenu = ^TMenu;
  21.    TMenu = RECORD
  22.       mi : ARRAY [1..20] OF TMenuIt;
  23.       util : ARRAY [1..20] OF BOOLEAN;
  24.       ni : WORD;
  25.    END;
  26.  
  27.  
  28. FUNCTION DoMenu(VAR m : TMenu; def: WORD): WORD;
  29.  
  30. PROCEDURE ClearMenu(VAR m : TMenu);
  31.  
  32. PROCEDURE AddItem(VAR m : TMenu; it : TMenuIt; outil: BOOLEAN);
  33.  
  34. VAR
  35.    mm : PMenu;   (* Menu var provided. Another quick hack. *)
  36.  
  37.  
  38.  
  39.    (* ========================================= *)
  40.  
  41. IMPLEMENTATION
  42.  
  43. USES
  44.    Output, Gfx;
  45.  
  46. FUNCTION DoMenu(VAR m : TMenu; def: WORD): WORD;
  47.   VAR
  48.      k : WORD;
  49.      pos, i: INTEGER;
  50.   BEGIN
  51.      pos := 1;
  52.         FOR i := 1 TO m.ni DO
  53.            IF (m.mi[i].Val = def) THEN
  54.               Pos := i;
  55.      REPEAT
  56.         FOR i := 1 TO m.ni DO
  57.            IF i = Pos THEN
  58.               DumpLine({'         '+}m.mi[i].Text, 1*16+15, i-1)
  59.            ELSE
  60.               IF m.util[i] THEN
  61.                 DumpLine({'         '+}m.mi[i].Text, 0*16+11, i-1)
  62.               ELSE
  63.                 DumpLine({'         '+}m.mi[i].Text, 0*16+9, i-1);
  64.         k := GetKey;
  65.         CASE CHAR(k) OF
  66.            #0 : CASE HI(k) OF
  67.                    72 : DEC(Pos);
  68.                    80 : INC(Pos);
  69.                    79 : Pos := m.ni;
  70.                    71 : Pos := 1;
  71.                    81 : IF (Pos <= (m.ni-5)) THEN INC(Pos, 5) ELSE Pos := m.ni;
  72.                    73 : IF (Pos > 5)         THEN DEC(Pos, 5) ELSE Pos := 1;
  73.                 END;
  74.  
  75.            #27 : BEGIN DoMenu := $FFFF; EXIT; END;
  76.            ' ', #13, #10 : BEGIN DoMenu := m.mi[Pos].Val; EXIT; END;
  77.            '8': DEC(Pos);
  78.            '2': INC(Pos);
  79.            '1': Pos := m.ni;
  80.            '7': Pos := 1;
  81.            '3': IF (Pos <= (m.ni-5)) THEN INC(Pos, 5) ELSE Pos := m.ni;
  82.            '9': IF (Pos > 5)         THEN DEC(Pos, 5) ELSE Pos := 1;
  83.         END;
  84.         IF (Pos > m.ni) THEN
  85.            Pos := 1
  86.         ELSE IF (Pos < 1) THEN
  87.            Pos := m.ni;
  88.         IF NOT (m.util[Pos]) THEN
  89.           CASE CHAR(k) OF
  90.              #0 : CASE HI(k) OF
  91.                    72,73,79 : REPEAT
  92.                                   DEC(Pos);
  93.                                   IF Pos<1 THEN
  94.                                     Pos := m.ni
  95.                                 UNTIL m.util[Pos];
  96.                    80,81,71 : REPEAT
  97.                                   INC(Pos);
  98.                                   IF Pos>m.ni THEN
  99.                                     Pos := 1;
  100.                                 UNTIL m.util[Pos];
  101.                   END;
  102.              '8','1','9': REPEAT
  103.                               DEC(Pos);
  104.                               IF Pos<1 THEN
  105.                                 Pos := m.ni;
  106.                           UNTIL m.util[Pos];
  107.              '2','7','3': REPEAT
  108.                               INC(Pos);
  109.                               IF Pos>m.ni THEN
  110.                                 Pos := 1;
  111.                           UNTIL m.util[Pos];
  112.            END;
  113.      UNTIL FALSE;
  114.   END;
  115.  
  116.  
  117. PROCEDURE ClearMenu(VAR m : TMenu);
  118.   BEGIN
  119.      m.ni := 0;
  120.   END;
  121.  
  122. PROCEDURE AddItem(VAR m : TMenu; it : TMenuIt; outil : BOOLEAN);
  123.   BEGIN
  124.      IF (m.ni < 20) THEN BEGIN
  125.         INC(m.ni);
  126.         m.mi[m.ni] := it;
  127.         m.util[m.ni] := outil
  128.      END;
  129.   END;
  130.  
  131.  
  132. BEGIN
  133.    New(mm);
  134.    ClearMenu(mm^)
  135. END.
  136.